perm filename TREE.PAS[S1,ALS] blob
sn#337865 filedate 1978-10-20 generic text, type T, neo UTF8
(*$A+,B-*)
PROGRAM TREESORT(OUTPUT);
(**********************************************************************)
CONST
MAXINDX= 8000;
TYPE
SORTINDX= 1 .. MAXINDX;
SORTITEM= INTEGER;
SORTARY= ARRAY [SORTINDX] OF SORTITEM;
VAR
A: SORTARY;
(**********************************************************************)
(*
PROCEDURE WRTINT(I, LEN: INTEGER);
VAR
POW10: INTEGER;
NEG: BOOLEAN;
DIGS: INTEGER;
TMP: INTEGER;
I: INTEGER;
LEN: INTEGER;
BEGIN
NEG:=FALSE;
IF I<0 THEN BEGIN
LEN:=LEN-1;
NEG:=TRUE;
I:=-I;
END;
DIGS:=0;
TMP:=I;
POW10:=1;
REPEAT
TMP:=TMP DIV 10;
POW10:=POW10*10;
DIGS:=DIGS+1;
UNTIL TMP=0;
FOR TMP:=LEN DOWNTO DIGS DO BEGIN
CHAROUT(' ');
END;
IF NEG THEN BEGIN
CHAROUT('-');
END;
REPEAT
POW10:=POW10 DIV 10;
TMP:=I DIV POW10;
CHAROUT(CHR(TMP+ORD('0')));
I:=I MOD POW10;
UNTIL POW10=1;
END;
)*
(**********************************************************************)
PROCEDURE INITARY(VAR ARY: SORTARY);
CONST
A= 54321;
C= 0;
M= 59999;
VAR
I: SORTINDX;
RAND: INTEGER;
BEGIN
RAND:=12345;
FOR I:=1 TO MAXINDX DO BEGIN
RAND:=((A*RAND+C) MOD M);
ARY[I]:=RAND;
END;
END;
(**********************************************************************)
(*
PROCEDURE PRTARY(VAR A: SORTARY);
VAR
I: SORTINDX;
BEGIN
FOR I:=1 TO MAXINDX DO BEGIN
WRTINT(A[I],12);
WRITELN(OUTPUT);
END;
WRITELN(OUTPUT);
END;
)*
(**********************************************************************)
PROCEDURE SORT(VAR A: SORTARY);
LABEL 1,2;
VAR
I,
K: SORTINDX;
J: INTEGER;
T: SORTITEM;
BEGIN
FOR I:=2 TO MAXINDX DO BEGIN
K:=I;
J:=I;
T:=A[I];
REPEAT
J:=J DIV 2;
IF T<=A[J] THEN GOTO 1;
A[K]:=A[J];
K:=J;
UNTIL J=1;
1:
A[K]:=T;
END;
FOR I:=MAXINDX-1 DOWNTO 1 DO BEGIN
T:=A[I+1];
A[I+1]:=A[1];
K:=1;
J:=2;
WHILE J<=I DO BEGIN
IF J<I THEN IF (A[J+1]>A[J]) THEN J:=J+1;
IF A[J]>T THEN BEGIN
A[K]:=A[J];
K:=J;
J:=2*J;
END ELSE GOTO 2;
END;
2:
A[K]:=T;
END;
END;
(**********************************************************************)
BEGIN
INITARY(A);
(*PRTARY(A);*)
SORT(A);
(*PRTARY(A);*)
END.
(**********************************************************************)